home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / KSEND1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-05  |  21.9 KB  |  537 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Check_Init  --- Check initialization packet from host        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Check_Init( VAR Check_OK : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Check_Init                                           *)
  10. (*                                                                      *)
  11. (*     Purpose:    Interprets initialization packet from host           *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Check_Init( VAR Check_OK : BOOLEAN );                         *)
  16. (*                                                                      *)
  17. (*           Check_OK --- If initialization packet was OK               *)
  18. (*                                                                      *)
  19. (*     Remarks:                                                         *)
  20. (*                                                                      *)
  21. (*        The initialization packet interpreted here has the following  *)
  22. (*        entries:                                                      *)
  23. (*                                                                      *)
  24. (*        Byte        Contents                                          *)
  25. (*        ----   ---------------------------------                      *)
  26. (*          1     Maximum packet size in bytes                          *)
  27. (*          2     Time out value in seconds                             *)
  28. (*          3     Number of pad characters                              *)
  29. (*          4     Padding character                                     *)
  30. (*          5     End of line character                                 *)
  31. (*          6     Control-quoting character                             *)
  32. (*          7     8th bit quote character                               *)
  33. (*          8     Block check type                                      *)
  34. (*                                                                      *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. VAR
  38.    Packet_Length : INTEGER;
  39.    Quote_8       : CHAR;
  40.  
  41. BEGIN (* Check_Init *)
  42.                                    (* Check that packet number is OK *)
  43.  
  44.    IF Rec_Packet_Num = ( Packet_Num MOD 64 ) THEN
  45.       Check_OK := TRUE;
  46.  
  47.    Packet_Length := LENGTH( Rec_Packet );
  48.  
  49.                                    (* Check packet length *)
  50.    IF Packet_Length >= 1 THEN
  51.       IF Kermit_UnChar( Rec_Packet[1] ) IN [4..94] THEN
  52.          Kermit_Packet_Size := Kermit_UnChar(Rec_Packet[1])
  53.       ELSE
  54.          Check_OK := FALSE;
  55.                                    (* Determine what other Kermit *)
  56.                                    (* wants.                      *)
  57.    IF Check_OK THEN
  58.       BEGIN
  59.                                    (* TimeOut value *)
  60.  
  61.          IF Packet_Length >= 2 THEN
  62.             IF Rec_Packet[2] <> ' ' THEN
  63.                His_TimeOut := Kermit_UnChar( Rec_Packet[2] );
  64.  
  65.                                    (* Number of pad characters    *)
  66.  
  67.          IF Packet_Length >= 3 THEN
  68.             IF Rec_Packet[3] <> ' ' THEN
  69.                My_Pad_Num := Kermit_UnChar( Rec_Packet[3] )
  70.             ELSE
  71.                My_Pad_Num := Kermit_Npad;
  72.  
  73.                                    (* Padding character         *)
  74.  
  75.          IF Packet_Length >= 4 THEN
  76.             IF Rec_Packet[4] <> ' ' THEN
  77.                My_Pad_Char := Kermit_Ctrl( Rec_Packet[4] )
  78.             ELSE
  79.                My_Pad_Char := Kermit_Pad_Char;
  80.  
  81.                                    (* End-of-line character     *)
  82.  
  83.          IF Packet_Length >= 5 THEN
  84.             IF Rec_Packet[5] <> ' ' THEN
  85.                Send_EOL := Kermit_UnChar( Rec_Packet[5] )
  86.             ELSE
  87.                Send_EOL := ORD( Kermit_EOL );
  88.  
  89.                                    (* Control-quoting character *)
  90.  
  91.          IF Packet_Length >= 6 THEN
  92.             BEGIN
  93.                IF ( Rec_Packet[6] = ' ' ) THEN
  94.                   His_Quote_Char := Kermit_Quote_Char
  95.                ELSE
  96.                   His_Quote_Char := Rec_Packet[6];
  97.             END
  98.          ELSE
  99.             His_Quote_Char := Kermit_Quote_Char;
  100.  
  101.                                    (* 8th-bit quoting character *)
  102.  
  103.          IF ( Packet_Length >= 7 ) THEN
  104.             CASE Rec_Packet[7] OF
  105.                                    (* Not quoting *)
  106.  
  107.                'N' : Quoting := FALSE;
  108.  
  109.                                    (* Willing to quote but won't *)
  110.  
  111.                'Y', ' ' : ;
  112.  
  113.                                    (* Use specified quoting character *)
  114.  
  115.                '!'..'>','`'..'~' : BEGIN
  116.                                       Quoting := TRUE;
  117.                                       His_Quote_8_Char := Rec_Packet[7];
  118.                                    END;
  119.  
  120.                                    (* Valid quote char not received *)
  121.  
  122.                ELSE
  123.                   Check_OK := FALSE;
  124.  
  125.             END (* CASE *)
  126.                                    (* Remote system not acknowledging *)
  127.                                    (* quoting.                        *)
  128.          ELSE
  129.             IF Quoting THEN
  130.                Check_OK := FALSE;
  131.  
  132.                                    (* Block check type *)
  133.  
  134.          IF Packet_Length >= 8 THEN
  135.             IF Rec_Packet[8] <> ' ' THEN
  136.                His_Chk_Type := Rec_Packet[8]
  137.             ELSE
  138.                His_Chk_Type := '1';
  139.  
  140.       END (* IF Check_OK *);
  141.  
  142.    Quoting := Quoting AND ( ( Data_Bits <>  8  ) OR
  143.                             ( Parity    <> 'N' ) ) AND
  144.               ( Kermit_File_Type_Var = Kermit_Binary );
  145.  
  146.                                    (* Display the parameter values *)
  147.    Display_Kermit_Init_Params;
  148.  
  149. END    (* Check_Init *);
  150.  
  151. (*----------------------------------------------------------------------*)
  152. (*           Check_ACK  --- Check ACK State for most packets            *)
  153. (*----------------------------------------------------------------------*)
  154.  
  155. PROCEDURE Check_ACK;
  156.  
  157. (*----------------------------------------------------------------------*)
  158. (*                                                                      *)
  159. (*     Procedure:  Check_ACK                                            *)
  160. (*                                                                      *)
  161. (*     Purpose:    Checks ACK status for most packets                   *)
  162. (*                                                                      *)
  163. (*     Calling Sequence:                                                *)
  164. (*                                                                      *)
  165. (*        Check_ACK;                                                    *)
  166. (*                                                                      *)
  167. (*     Remarks:                                                         *)
  168. (*                                                                      *)
  169. (*        The packet to be sent is in Packet_Buffer.                    *)
  170. (*                                                                      *)
  171. (*----------------------------------------------------------------------*)
  172.  
  173. VAR
  174.    A_Ch: CHAR;
  175.  
  176. BEGIN (* Check_ACK *)
  177.                                    (* Assume bad packet to start *)
  178.    ACK_OK := FALSE;
  179.                                    (* Pick up a packet           *)
  180.    Receive_Packet;
  181.  
  182.    IF Packet_OK AND ( NOT Kermit_Abort ) THEN
  183.       BEGIN
  184.                                    (* Check if ACK or NAK packet received. *)
  185.                                    (* May also be error packet.            *)
  186.  
  187.          CASE Kermit_Packet_Type OF
  188.  
  189.                                    (* Make sure ACK is for correct block *)
  190.  
  191.             ACK_Pack :   IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
  192.                             ACK_OK := TRUE;
  193.  
  194.             NAK_Pack :   BEGIN
  195.  
  196.                             IF ( Rec_Packet_Num = 0 ) THEN
  197.                                Rec_Packet_Num := 63
  198.                             ELSE
  199.                                Rec_Packet_Num := Rec_Packet_Num - 1;
  200.  
  201.                                    (* NAK for next is ACK for present *)
  202.  
  203.                             IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
  204.                                ACK_OK := TRUE;
  205.  
  206.                          END;
  207.                                    (* Error packet sent *)
  208.             Error_Pack : BEGIN
  209.                             GoToXY( 25 , 5 );
  210.                             WRITE( '>> Error from remote Kermit <<' );
  211.                             ClrEol;
  212.                             Kermit_Abort := TRUE;
  213.                             GoToXY( 2 , 8 );
  214.                             WRITE( Rec_Packet );
  215.                             ClrEol;
  216.                             GoToXY( 2 , 9 );
  217.                             WRITE('Hit any key to continue ... ');
  218.                             READ( Kbd, A_Ch );
  219.                             IF ( ORD( A_Ch ) = ESC ) AND KeyPressed THEN
  220.                                READ( Kbd, A_Ch );
  221.                          END;
  222.                                    (* Something else -- don't ACK it *)
  223.             ELSE
  224.                ACK_OK := FALSE;
  225.  
  226.          END (* CASE *)
  227.  
  228.       END
  229.    ELSE
  230.       ACK_OK := FALSE;
  231.  
  232.    IF ( NOT ACK_OK ) THEN
  233.       BEGIN
  234.          Packets_Bad := Packets_Bad + 1;
  235.          Update_Kermit_Display;
  236.       END;
  237.  
  238. END    (* Check_ACK *);
  239.  
  240. (*----------------------------------------------------------------*)
  241. (*                Send_Packet --- send a packet                   *)
  242. (*----------------------------------------------------------------*)
  243.  
  244. PROCEDURE Send_Packet;
  245.  
  246. (*----------------------------------------------------------------------*)
  247. (*                                                                      *)
  248. (*     Procedure:  Send_Packet                                          *)
  249. (*                                                                      *)
  250. (*     Purpose:    Sends a Kermit packet to remote host                 *)
  251. (*                                                                      *)
  252. (*     Calling Sequence:                                                *)
  253. (*                                                                      *)
  254. (*        Send_Packet;                                                  *)
  255. (*                                                                      *)
  256. (*     Remarks:                                                         *)
  257. (*                                                                      *)
  258. (*        The packet to be sent is in Packet_Buffer.                    *)
  259. (*                                                                      *)
  260. (*----------------------------------------------------------------------*)
  261.  
  262. VAR
  263.    Count:  INTEGER;
  264.    StrNum: STRING[3];
  265.  
  266. BEGIN (* Send_Packet *)
  267.                                    (* Purge input buffer before send *)
  268.    Async_Purge_Buffer;
  269.                                    (* Send this packet               *)
  270.  
  271.    Async_Send_String( Packet_Buffer );
  272.  
  273.                                    (* Update packets sent count      *)
  274.  
  275.    Packets_Sent := Packets_Sent + 1;
  276.  
  277.    Update_Kermit_Display;
  278.  
  279. END   (* Send_Packet *);
  280.  
  281. (*----------------------------------------------------------------*)
  282. (*              Build_Packet --- Build a packet                   *)
  283. (*----------------------------------------------------------------*)
  284.  
  285. PROCEDURE Build_Packet;
  286.  
  287. (*----------------------------------------------------------------------*)
  288. (*                                                                      *)
  289. (*     Procedure:  Build_Packet                                         *)
  290. (*                                                                      *)
  291. (*     Purpose:    Builds a Kermit packet                               *)
  292. (*                                                                      *)
  293. (*     Calling Sequence:                                                *)
  294. (*                                                                      *)
  295. (*        Build_Packet;                                                 *)
  296. (*                                                                      *)
  297. (*     Remarks:                                                         *)
  298. (*                                                                      *)
  299. (*        This routine add the block number and checksum to the data in *)
  300. (*        Packet_Buffer_Data.                                           *)
  301. (*                                                                      *)
  302. (*----------------------------------------------------------------------*)
  303.  
  304. VAR
  305.    CheckSum        : INTEGER;
  306.    Count           : INTEGER;
  307.    Index           : INTEGER;
  308.    Bit_Count       : INTEGER;
  309.    Temp_Pack       : Kermit_Packet_String;
  310.    CheckSum_String : STRING[3];
  311.    A_Byte          : BYTE;
  312.    Check_Type      : INTEGER;
  313.  
  314. BEGIN (* Build_Packet *)
  315.                                    (* Add block header, length, packet *)
  316.                                    (* number to front of packet data   *)
  317.  
  318.    Check_Type    := ORD( His_Chk_Type ) - ORD('0');
  319.  
  320.    Packet_Buffer := Kermit_Header_Char +
  321.                     Kermit_Char40( LENGTH( Packet_Buffer_Data ) + Check_Type + 1 ) +
  322.                     Kermit_Char40( Packet_Num MOD 64 ) + Packet_Buffer_Data;
  323.  
  324.                                    (* Calculate checksum/crc *)
  325.    CheckSum      := 0;
  326.  
  327.    CASE His_Chk_Type OF
  328.  
  329.       '1': BEGIN
  330.  
  331.               FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
  332.                  CheckSum := CheckSum + ORD( Packet_Buffer[ Count ] );
  333.  
  334.               CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  335.  
  336.               CheckSum_String := Kermit_Char40( CheckSum );
  337.  
  338.            END;
  339.  
  340.       '2': BEGIN
  341.  
  342.               FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
  343.                  CheckSum := CheckSum + ORD(Packet_Buffer[Count]);
  344.  
  345.               CheckSum        := CheckSum AND 4095;
  346.  
  347.               CheckSum_String := Kermit_Char40( CheckSum SHR 6  ) +
  348.                                  Kermit_Char40( CheckSum AND 63 );
  349.  
  350.            END;
  351.  
  352.       '3': BEGIN
  353.  
  354.               FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
  355.                  BEGIN
  356.                     A_Byte   := ORD( Packet_Buffer[Count] );
  357.                     CheckSum := Kermit_CRC( CheckSum , A_Byte );
  358.                  END;
  359.  
  360.               CheckSum_String := Kermit_Char40( ( CheckSum SHR 12 ) AND 63 ) +
  361.                                  Kermit_Char40( ( CheckSum SHR 6  ) AND 63 ) +
  362.                                  Kermit_Char40( CheckSum AND 63   );
  363.  
  364.            END;
  365.  
  366.    END (* CASE *);
  367.                                    (* Append checksum, end of line *)
  368.                                    (* character to packet.         *)
  369.  
  370.    Packet_Buffer := Packet_Buffer + CheckSum_String + CHR( Send_EOL );
  371.  
  372.                                    (* Add requested padding *)
  373.    IF ( My_Pad_Num > 0 ) THEN
  374.       FOR Count := 1 TO My_Pad_Num DO
  375.          Packet_Buffer := My_Pad_Char + Packet_Buffer;
  376.  
  377. END    (* Build_Packet *);
  378.  
  379. (*----------------------------------------------------------------*)
  380. (*     Kermit_Finish_Server --- Finish server mode transfers      *)
  381. (*----------------------------------------------------------------*)
  382.  
  383. PROCEDURE Kermit_Finish_Server;
  384.  
  385. (*----------------------------------------------------------------------*)
  386. (*                                                                      *)
  387. (*     Procedure:  Kermit_Finish_Server                                 *)
  388. (*                                                                      *)
  389. (*     Purpose:    Tells remote Kermit server to quit                   *)
  390. (*                                                                      *)
  391. (*     Calling Sequence:                                                *)
  392. (*                                                                      *)
  393. (*        Kermit_Finish_Server;                                         *)
  394. (*                                                                      *)
  395. (*     Remarks:                                                         *)
  396. (*                                                                      *)
  397. (*        This routine sends the 'FINISH' packet, not the 'LOGOUT'      *)
  398. (*        packet.                                                       *)
  399. (*                                                                      *)
  400. (*----------------------------------------------------------------------*)
  401.  
  402. VAR
  403.    Try      : INTEGER;
  404.  
  405. BEGIN (* Kermit_Finish_Server *)
  406.                                    (* Build FINISH packet *)
  407.    Packet_Buffer_Data := 'GF';
  408.    Packet_Num         := 0;
  409.    Try                := 0;
  410.  
  411.    Build_Packet;
  412.                                    (* Don't update display     *)
  413.    Logging_Out_Server := TRUE;
  414.                                    (* Send FINISH packet until *)
  415.                                    (* acknowledged or too many *)
  416.                                    (* tries.                   *)
  417.    REPEAT
  418.       Try := Try + 1;
  419.       Send_Packet;
  420.       Check_ACK;
  421.    UNTIL ( Kermit_Abort OR ACK_OK OR ( Try > Kermit_MaxTry ) );
  422.  
  423.    IF ( Try > Kermit_MaxTry ) OR Kermit_Abort THEN
  424.       BEGIN
  425.          GoToXY( 25 , 5 );
  426.          WRITE('Error ...');
  427.          ClrEol;
  428.          GoToXY( 1 , 7 );
  429.          WRITE('Unable to tell remote server to quit.');
  430.          ClrEol;
  431.          DELAY( One_Second_Delay );
  432.       END;
  433.  
  434.    Logging_Out_Server := FALSE;
  435.  
  436. END    (* Kermit_Finish_Server *);
  437.  
  438. (*----------------------------------------------------------------------*)
  439. (*               Send_ACK  --- Send acknowledge for a packet            *)
  440. (*----------------------------------------------------------------------*)
  441.  
  442. PROCEDURE Send_ACK;
  443.  
  444. (*----------------------------------------------------------------------*)
  445. (*                                                                      *)
  446. (*     Procedure:  Send_ACK                                             *)
  447. (*                                                                      *)
  448. (*     Purpose:    Sends acknowledge for packet to host                 *)
  449. (*                                                                      *)
  450. (*     Calling Sequence:                                                *)
  451. (*                                                                      *)
  452. (*        Send_ACK;                                                     *)
  453. (*                                                                      *)
  454. (*     Calls:                                                           *)
  455. (*                                                                      *)
  456. (*        Build_Packet;                                                 *)
  457. (*        Send_Packet;                                                  *)
  458. (*                                                                      *)
  459. (*----------------------------------------------------------------------*)
  460.  
  461. VAR
  462.    Save_CHK: CHAR;
  463.    Quote_8 : CHAR;
  464.  
  465. BEGIN (* Send_ACK *)
  466.  
  467.    IF ( Kermit_State = Receive_Init ) OR
  468.       ( Kermit_State = Get_File     ) THEN
  469.       BEGIN
  470.  
  471.          IF Quoting THEN
  472.             Quote_8 := 'Y'
  473.          ELSE
  474.             Quote_8 := 'N';
  475.  
  476.          Packet_Buffer_Data :=  'Y' + Kermit_Char40( Kermit_Packet_Size ) +
  477.                                       Kermit_Char40( Kermit_TimeOut )     +
  478.                                       Kermit_Char40( My_Pad_Num )         +
  479.                                       Kermit_Ctrl  ( My_Pad_Char )        +
  480.                                       Kermit_Char40( Send_EOL )           +
  481.                                       His_Quote_Char                      +
  482.                                       Quote_8                             +
  483.                                       His_Chk_Type;
  484.  
  485.          Save_CHK     := His_Chk_Type;
  486.          His_Chk_Type := '1';
  487.  
  488.          Build_Packet;
  489.          Send_Packet;
  490.  
  491.          His_Chk_Type := Save_CHK;
  492.  
  493.       END
  494.    ELSE
  495.       BEGIN
  496.  
  497.          Packet_Buffer_Data := 'Y';
  498.  
  499.          Build_Packet;
  500.          Send_Packet;
  501.  
  502.       END;
  503.  
  504. END   (* Send_ACK *);
  505.  
  506. (*----------------------------------------------------------------------*)
  507. (*         Send_NAK  --- Send negative acknowledge for a packet         *)
  508. (*----------------------------------------------------------------------*)
  509.  
  510. PROCEDURE Send_NAK;
  511.  
  512. (*----------------------------------------------------------------------*)
  513. (*                                                                      *)
  514. (*     Procedure:  Send_NAK                                             *)
  515. (*                                                                      *)
  516. (*     Purpose:    Sends negative acknowledge for packet to host        *)
  517. (*                                                                      *)
  518. (*     Calling Sequence:                                                *)
  519. (*                                                                      *)
  520. (*        Send_NAK;                                                     *)
  521. (*                                                                      *)
  522. (*     Calls:                                                           *)
  523. (*                                                                      *)
  524. (*        Build_Packet;                                                 *)
  525. (*        Send_Packet;                                                  *)
  526. (*                                                                      *)
  527. (*----------------------------------------------------------------------*)
  528.  
  529. BEGIN (* Send_NAK *)
  530.  
  531.    Packet_Buffer_Data := 'N';
  532.  
  533.    Build_Packet;
  534.    Send_Packet;
  535.  
  536. END   (* Send_NAK *);
  537.